home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 46 / pascal / settime.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-15  |  5.0 KB  |  165 lines

  1. PROGRAM settime ;
  2.         { program to set the date and time in auto folder   }
  3.         { this makes sure that the time is always correct   }
  4.         { written in OSS Pesonal Pascal by William R. Good  }
  5.         { July 1986 used by permission from OSS             }
  6.  
  7.   CONST
  8.     {$I GEMCONST.PAS}
  9.  
  10.   TYPE
  11.     {$I gemtype.pas}
  12.  
  13.   VAR
  14.     dialog : Dialog_Ptr ;
  15.     dateint, timeint : integer ;
  16.     date, time : string ;
  17.     datestring, timestring : string[255] ;
  18.  
  19.   {$I gemsubs}
  20.  
  21.    { had to use these two XBIOS functions because }
  22.    { the GEMDOS calls did not work in auto folder }
  23.    { if anybody has a reason for this leave email }
  24.    { on genie thanks William R. Good              }
  25.  
  26. FUNCTION getimedate : Long_Integer ;
  27.    XBIOS( 23 ) ;
  28.  
  29. PROCEDURE fixtime( dateintg, timeintg : integer ) ;
  30.    XBIOS( 22 ) ;
  31.  
  32. PROCEDURE stoi ( var int : integer ; inttext : string ) ;
  33.   { Takes the string "inttext" and converts it to the integer }
  34.   { "int".            used to get a value out of a dialog box }
  35.  
  36.   var
  37.      len, index, dummy : integer ;
  38.   begin
  39.      int := 0 ;
  40.      len := length ( inttext ) ;
  41.      for index := 1 to len do
  42.         begin
  43.            int := (10*int)+(ord(inttext[index])-ord('0')) ;
  44.         end ;
  45.   end ; {stoi}
  46.  
  47. PROCEDURE Inttostr (int : integer; VAR inttext : string);
  48. {Generic procedure to convert integers to strings, packs front with zeros.}
  49.  
  50. VAR
  51.  place,digit : integer;
  52.  tempstr : string ;
  53. BEGIN
  54.    tempstr := '' ;
  55.  FOR place:=1 DOWNTO 0 DO
  56.   BEGIN
  57.    digit:=int DIV Round(PwrOfTen(place));
  58.    tempstr := concat (tempstr, chr(digit+ord('0'))) ;
  59.    int:=int MOD Round(PwrOfTen(place));
  60.   END;
  61. inttext := tempstr ;
  62. END; {Inttostr}
  63.  
  64. PROCEDURE getdatetime (var datestr, timestr : string ) ;
  65. { procedure to return the date & time in a string }
  66.  
  67.    VAR
  68.       ldateint, ltempint, ltmpint : long_integer ;
  69.       dateint, timeint, tempint, tmpint,
  70.       hourint, minint, secint,
  71.       yearint, monthint, dayint : integer ;
  72.       hourstr, minstr, secstr,
  73.       yearstr, monthstr, daystr : string ;
  74.    BEGIN
  75.       ldateint := getimedate ;
  76.       ltempint := shr( ldateint, 16 ) ;
  77.       dateint := int( ltempint ) ;
  78.       yearint := dateint div 512 ;
  79.       yearint := yearint + 80 ;
  80.       tempint := dateint mod 512 ;
  81.       monthint := tempint div 32 ;
  82.       dayint := tempint mod 32 ;
  83.       inttostr( yearint, yearstr ) ;
  84.       inttostr( monthint, monthstr ) ;
  85.       inttostr( dayint, daystr ) ;
  86.       datestr := concat( monthstr, daystr, yearstr ) ;
  87.  
  88.       ltempint := shl( ldateint, 15 ) ;
  89.       ltmpint := shr( ltempint , 15 ) ;
  90.       timeint := int( ltmpint ) ;
  91.       hourint := timeint div $800 ;
  92.       tempint := timeint mod $800 ;
  93.       minint := tempint div $20 ;
  94.       secint := tempint mod $20;
  95.       secint := secint * 2 ;
  96.       hourint := hourint + tmpint ;
  97.       inttostr( hourint, hourstr ) ;
  98.       inttostr( minint, minstr ) ;
  99.       inttostr( secint, secstr ) ;
  100.       timestr := concat( hourstr, minstr, secstr ) ;
  101.    END ; { getdatetime }
  102.  
  103. procedure settime ( var timeint: integer ; timestr : string ) ;
  104.    { sets the time in the machine }
  105.  
  106.    var
  107.       tempint, testtime,
  108.       hourint, minint, secint : integer ;
  109.       hourstr, minstr, secstr : string ;
  110.    begin
  111.       secstr := copy( timestr, 5, 2 ) ;
  112.       minstr := copy( timestr, 3, 2 ) ;
  113.       hourstr := copy( timestr, 1, 2 ) ;
  114.       stoi ( hourint, hourstr ) ;
  115.       stoi ( minint, minstr ) ;
  116.       stoi ( secint, secstr ) ;
  117.       hourint := hourint * $800 ;
  118.       minint := minint * $20 ;
  119.       timeint := hourint + minint + secint ;
  120.    end ; { settime }
  121.  
  122. procedure setdate ( var dateint : integer ; datestr : string ) ;
  123.    { sets the date in the machine }
  124.  
  125.    var
  126.       testdate, tempint, tmpint,
  127.       yearint, monthint, dayint : integer ;
  128.       yearstr, monthstr, daystr : string ;
  129.    begin
  130.       daystr := copy( datestr, 3, 2 ) ;
  131.       monthstr := copy( datestr, 1, 2 ) ;
  132.       yearstr := copy( datestr, 5, 2 ) ;
  133.       stoi ( yearint, yearstr ) ;
  134.       stoi ( monthint, monthstr ) ;
  135.       stoi ( dayint, daystr ) ;
  136.       yearint := yearint - 80 ;
  137.       yearint := yearint * 512 ;
  138.       monthint := monthint * 32 ;
  139.       dateint := yearint + monthint + dayint ;
  140.    end ; { setdate }
  141.  
  142.   BEGIN { main }
  143.      date := '' ;
  144.      time := '' ;
  145.      getdatetime ( date, time ) ;
  146.      writeln ( ' Settime by William R. Good ver 1.0 ' ) ;
  147.      writeln ( ' Portions of this product are  ' ) ;
  148.      writeln ( ' Copyright (c) 1986 OSS and CCD ' ) ;
  149.      writeln ( ' Used by Permission of OSS ' ) ;
  150.      writeln ( ' Written on 07-26-86 ' ) ;
  151.      writeln ;
  152.      writeln ( ' Press Return two times if no change' ) ;
  153.      writeln ;
  154.      writeln ( ' date : ', date, '     time : ', time ) ;
  155.      writeln ;
  156.      write ( ' please enter date MMDDYY :' ) ;
  157.      readln ( datestring ) ;
  158.      writeln ;
  159.      write ( ' please enter time HHMMSS :' ) ;
  160.      readln ( timestring ) ;
  161.      setdate ( dateint, datestring ) ;
  162.      settime ( timeint, timestring ) ;
  163.      fixtime ( dateint, timeint ) ;
  164.   END. { settime }
  165.